home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 43 / Amiga Format CD43 (1999)(Future Publishing)(GB)(Track 1 of 2)[!][issue 1999-09].iso / -serious- / comms / other / ums / tools / rexxdossupport / txt / rxlibssupport.mod < prev   
Text File  |  1999-06-14  |  5KB  |  162 lines
  1. (*(***********************************************************************
  2.  
  3. :Program.    RxLibsSupport.mod
  4. :Contents.   support functions for rexx function libraries
  5. :Author.     hartmtut Goebel [hG]
  6. :Address.    Aufseßplatz 5, D-90459 Nürnberg
  7. :Address.    UseNet: hartmut@oberon.nbg.sub.org
  8. :Copyright.  Copyright © 1994-1996 by hartmtut Goebel
  9. :Language.   Oberon-2
  10. :Translator. Amiga Oberon 3.11
  11. :Imports.    Printf (Martin Horneffer), MoreStrings [hG]
  12. :Version.    $VER: RxLibsSupport.mod 1.2 (30.1.96) Copyright © 1994-1996 by hartmtut Goebel
  13.  
  14. (* $StackChk- $NilChk- $RangeChk- $CaseChk- $OvflChk- $ReturnChk- $ClearVars- *)
  15. (****i* /--history-- ***************************************
  16. *
  17. *  1.2  30 Jan 1996
  18. *       · switched to Martin Horneffers Printf
  19. *
  20. *  1.1  07 May 1994
  21. *       · added ArgsPresent()
  22. *
  23. *  1.0  23 Jan 1994
  24. *       · initial release
  25. *
  26. *********************************************************************)*)*)
  27.  
  28. MODULE RxLibsSupport;
  29.  
  30. IMPORT
  31.   e := Exec,
  32.   str := Strings,
  33.   Printf,
  34.   ms := MoreStrings,
  35.   rx := Rexx,
  36.   rxs := RexxSysLib,
  37.   rvi := RVI,
  38.   y := SYSTEM;
  39.  
  40. CONST
  41.   versionString = "$VER: RxLibsSupport 1.2 (30.1.96) Copyright © 1994-1996 by hartmtut Goebel";
  42.  
  43.   strTRUE  * = "1";
  44.   strFALSE * = "0";
  45.  
  46.   progNotFound * = rx.err10001;
  47.   noMemory     * = rx.err10003;
  48.   badNumArgs   * = rx.err10017;
  49.  
  50. TYPE
  51.   ConvertLongBuffer * = ARRAY 16 OF CHAR;
  52.   Function * = PROCEDURE (msg: rx.RexxMsgPtr; VAR resultStr: e.LSTRPTR): INTEGER;
  53.  
  54.   FunctionListEntry * = STRUCT
  55.     name     *: e.LSTRPTR;
  56.     minArgs  *: INTEGER;
  57.     maxArgs  *: INTEGER;
  58.     function *: Function;
  59.   END;
  60.  
  61.   FunctionList = ARRAY OF FunctionListEntry;
  62.  
  63. (* ---------------------------------------------------------------- *)
  64.  
  65. PROCEDURE SetRC * (msg: rx.RexxMsgPtr; rc: LONGINT): INTEGER;
  66. VAR
  67.   longbuff: ConvertLongBuffer;
  68. BEGIN
  69.   Printf.OSPrintF(longbuff, "%ld", rc);                                    (*$RangeChk-*)
  70.   RETURN SHORT(rvi.SetRexxVar(msg,"RC",longbuff,str.Length(longbuff))); (*$RangeChk=*)
  71. END SetRC;
  72.  
  73. PROCEDURE SetRC5 * (msg: rx.RexxMsgPtr): INTEGER;
  74. BEGIN                                           (*$RangeChk-*)
  75.   RETURN SHORT(rvi.SetRexxVar(msg,"RC","5",1)); (*$RangeChk=*)
  76. END SetRC5;
  77.  
  78. PROCEDURE SetRC0 * (msg: rx.RexxMsgPtr): INTEGER;
  79. BEGIN                                           (*$RangeChk-*)
  80.   RETURN SHORT(rvi.SetRexxVar(msg,"RC","0",1)); (*$RangeChk=*)
  81. END SetRC0;
  82.  
  83. (* ---------------------------------------------------------------- *)
  84.  
  85. (* IsValidArg()
  86.  *
  87.  * testes whether arguments <argNum> is a valid arguments, this
  88.  * means is either not given or the first charakter is <c>.
  89.  * <set> will be true if the argument is given and is valid,
  90.  * false otherwise.
  91.  *)
  92. PROCEDURE IsValidArg * (msg: rx.RexxMsgPtr;
  93.                         argNum: INTEGER;
  94.                         c: CHAR;
  95.                         VAR set: BOOLEAN): BOOLEAN;
  96. BEGIN
  97.   set := FALSE;
  98.   IF (rx.ActionArg(msg.action) < argNum) OR (msg.args[argNum] = NIL) THEN
  99.     RETURN TRUE;
  100.   ELSIF CAP(msg.args[argNum][0]) = c THEN
  101.     set := TRUE;
  102.     RETURN TRUE;
  103.   ELSE
  104.     RETURN FALSE;
  105.   END;
  106. END IsValidArg;
  107.  
  108.  
  109. (* ArgsPresent()
  110.  *
  111.  * checks whether all arguments between <start> and <stop> (including both)
  112.  * are present (non-null)
  113.  *)
  114.  
  115. PROCEDURE ArgsPresent * (msg: rx.RexxMsgPtr; start, stop: INTEGER): BOOLEAN;
  116. BEGIN
  117.   WHILE start <= stop DO
  118.     IF msg.args[start] = NIL THEN RETURN FALSE; END;
  119.     INC(start);
  120.   END;
  121.   RETURN TRUE;
  122. END ArgsPresent;
  123.  
  124. (* ---------------------------------------------------------------- *)
  125.  
  126. PROCEDURE Dispatch * (msg: rx.RexxMsgPtr;
  127.                       VAR resultStr: e.LSTRPTR;
  128.                       functionList: FunctionList): LONGINT;   (* $CopyArrays- *)
  129. VAR
  130.   func: FunctionListEntry;
  131.   retval: LONGINT;
  132.   i, numArgs: INTEGER;
  133. BEGIN
  134.   resultStr := NIL;
  135.   IF (msg = NIL) OR (rx.ActionCode(msg.action) # rx.rxFunc) THEN
  136.     RETURN progNotFound;
  137.   END;
  138.   i := 0;
  139.   LOOP
  140.     IF i >= LEN(functionList) THEN
  141.       RETURN progNotFound; END;
  142.     IF ms.NCStrCmp(functionList[i].name^,msg.args[0]^) = 0 THEN
  143.       EXIT; END;
  144.     INC(i);
  145.   END;
  146.  
  147.   numArgs := (*$RangeChk-*) SHORT(rx.ActionArg(msg.action)); (*$RangeChk=*)
  148.   IF (numArgs < functionList[i].minArgs) OR (numArgs > functionList[i].maxArgs) THEN
  149.     RETURN badNumArgs;
  150.   END;
  151.  
  152.   retval := functionList[i].function(msg, resultStr);
  153.   IF (retval = rx.ok) & (resultStr = NIL) THEN
  154.     resultStr := rxs.CreateArgstring("",0);
  155.     IF resultStr = NIL THEN retval := noMemory; END;
  156.   END;
  157.   RETURN retval;
  158. END Dispatch;
  159.  
  160. END RxLibsSupport.
  161.  
  162.